home *** CD-ROM | disk | FTP | other *** search
/ A.C.E. 2 / ACE CD 2.iso / FILES / UTILS / HSBASIC2.DMS / in.adf / HB2Examples1.3.Lha / Examples / IFF_ILBM / IFF_ILBM.bas < prev    next >
Encoding:
BASIC Source File  |  1994-05-03  |  9.4 KB  |  317 lines
  1. ''IFF ILBM display program
  2. '' based partly on  Commodore example program.
  3.  
  4. DEFINT A-Z
  5. 'REM $INCLUDE Exec.bh
  6. 'REM $INCLUDE Graphics.bh
  7. 'REM $INCLUDE IFFParse.bh
  8. 'REM $INCLUDE DOS.bh
  9. 'REM $INCLUDE DataTypes/PictureClass.bc
  10. 'REM $INCLUDE Utility.bc
  11. 'REM $INCLUDE Intuition.bh
  12.  
  13. REM $INCLUDE Blib/IFFBufIO.bas
  14. REM $INCLUDE BLib/BitMapSupport.bas
  15.  
  16.  
  17. ' unpackrow.bas  Convert data from "cmpByteRun1" run compression
  18. ' include the machine code routine. assembler source is UnPackRow.s
  19. ' to make Unpackrow.bas from UnPackRow.s use OtoTaglist UnPackRow.
  20.  
  21. 'DECLARE SUB UnPackRow CDECL (BYVAL pSourceptr&,BYVAL pDestptr&,BYVAL  srcBytes&, BYVAL  dstBytes0&, BYVAL resultptr&)
  22. REM $INCLUDE Unpackrow.bas
  23. SUB UnPackRow (BYVAL pSourceptr&,BYVAL pDestptr&,BYVAL  srcBytes0&, BYVAL  dstBytes0&, BYVAL resultptr&)
  24. SHARED unpackrow&(1)
  25.  CALL LOC VARPTR(unpackrow&(0)),pSourceptr&,pDestptr&,srcBytes0&,dstBytes0&,resultptr&
  26. END SUB
  27.  
  28.  
  29. FUNCTION BytesPerRow&(BYVAL w)
  30. BytesPerRow&= (w+15) >> 4 << 1
  31. END FUNCTION
  32.  
  33. SUB readBODY(BYVAL iff&, BYVAL bm&, BYVAL bmhd&)
  34.     STATIC w, h, nplanes, row, plane, pp&, numBytes, compression
  35.     STATIC buf&, bufSize, used, bytesBetweenRows&, srcRowBytes
  36.     STATIC junk, bufpos&, bytesread, oldbufpos&, oldpp&, bytestodo,unpackres
  37.     
  38.     w = PEEKW(bmhd& + bmh_Width)
  39.     h = PEEKW(bmhd& + bmh_Height)
  40.     nplanes = PEEKB(bmhd& + bmh_Depth)
  41.     srcRowBytes = BytesPerRow&(w)
  42.  
  43.     bytesBetweenRows& =PEEKW(bm&+bytesperrow)
  44.     compression = PEEKB(bmhd& + bmh_Compression)
  45.     bufSize=8192
  46.     buf& = AllocMem(bufSize, MEMF_ANY&)
  47.     IF buf& THEN
  48.         used = 0
  49.         bufpos&=buf&
  50.         numbytes=ReadChunkBytes&(iff&, bufpos&, BufSize)
  51.         IF compression=cmpNone& THEN
  52.             FOR row = 0 TO h - 1
  53.                 FOR plane = 0 TO nplanes - 1
  54.                     pp& = PEEKL(bm& + Planes + plane * 4)+ row*bytesBetweenRows&
  55.                     IF used+srcRowBytes>numbytes THEN
  56.                         IF numbytes<>used THEN    CopyMem bufpos&,pp&,numbytes-used
  57.                         pp&=pp&+numbytes-used
  58.                         bytestodo= srcRowBytes-(numbytes-used)
  59.                         numbytes=ReadChunkBytes&(iff&, buf&, BufSize)    
  60.                         bufpos&=buf&
  61.                         used=0
  62.                     ELSE
  63.                         bytestodo= srcRowBytes
  64.                     END IF
  65.                     CopyMem bufpos&,pp&, bytestodo
  66.                     bufpos&=bufpos&+bytestodo
  67.                     used=used+bytestodo
  68.                 NEXT plane
  69.             NEXT row
  70.         ELSE
  71.             FOR row = 0 TO h - 1
  72.                 FOR plane = 0 TO nplanes - 1
  73.                     pp& = PEEKL(bm& + Planes + plane * 4)+ row*bytesBetweenRows&
  74.                     oldbufpos&=bufpos&: oldpp&=pp&
  75.                     CALL UnpackRow(VARPTR(bufpos&),VARPTR(pp&), numBytes ,srcRowBytes, VARPTR(unpackres))
  76.                     IF unpackres=0 THEN
  77.                         CopyMem oldbufpos&,buf&,numbytes
  78.                         bytesread=ReadChunkBytes&(iff&, buf&+Numbytes, bufSize-Numbytes)
  79.                         IF bytesread=0 THEN 
  80.                             PRINT "Source truncated": EXIT SUB
  81.                         END IF
  82.                         numbytes=numbytes + bytesread
  83.                         bufpos&=buf&: pp&=oldpp&: oldbufpos&=buf&
  84.                         CALL UnPackRow(VARPTR(bufpos&),VARPTR(pp&), numBytes ,srcRowBytes,VARPTR(unpackres))
  85.                         IF unpackres=0 THEN
  86.                             PRINT "buffer too small":EXIT SUB
  87.                         END IF
  88.                     END IF
  89.                     numbytes=numbytes-(bufpos&-oldbufpos&)
  90.                     
  91.                 NEXT plane
  92.             NEXT row
  93.         END IF
  94.         FreeMem buf&,bufsize
  95.     END IF
  96. END SUB
  97.  
  98.  
  99. FUNCTION getcmap (BYVAL iff&, BYVAL screenptr&)
  100. STATIC sp&
  101. STATIC n        ' number of colours
  102. STATIC rgb&        ' pointer to cmap
  103. STATIC dest&    ' pointer to table being generated
  104. STATIC shifted    ' flag set to duplicate top 4 bits of color for old CMAPs
  105. STATIC i         ' loop variable
  106. STATIC c        ' current color gun bits
  107. STATIC table(1)    ' table for LoadRGB data
  108.  
  109.     sp& = FindProp& (iff&, ID_ILBM&, ID_CMAP&)
  110.     IF sp&=0 THEN
  111.         getcmap=0
  112.         EXIT FUNCTION
  113.     END IF
  114.     rgb& =PEEKL(sp&+sp_Data)
  115.     n    = PEEKL(sp&+sp_Size) \ ColorRegister_sizeof
  116.     ' n is the number of colors in the CMAP
  117.     IF PEEKW(LIBRARY("graphics.library")+lib_version)>=39 THEN
  118.         shifted = -1
  119.         FOR i=0 TO n*3-1
  120.             IF     PEEKB(rgb&+i) AND &h0F THEN
  121.                 shifted=0
  122.                 EXIT FOR
  123.             END IF
  124.         NEXT i
  125.         REDIM table(n*6+2)    ' 6 words per colour and 2 extras for header,1 at end
  126.         table(0)=n            'set n colours
  127.         table(1)=0            ' starting at 0
  128.         dest&=VARPTR(table(2))
  129.         FOR i=0 TO n*3-1            ' do this for each R,G,B of the N colors
  130.             c=PEEKB(rgb&) : INCR rgb&
  131.             IF shifted THEN    c=c OR (c>>4)
  132.             POKEB dest&,c    : INCR dest&        
  133.             POKEB dest&,c    : INCR dest&        
  134.             POKEB dest&,c    : INCR dest&        
  135.             POKEB dest&,c    : INCR dest&        
  136.         NEXT i
  137.         POKEW dest&,0        'a list of 0
  138.                 
  139.         LoadRGB32 screenptr&+screenViewPort,VARPTR(table(0))
  140.  
  141.     ELSE
  142.     
  143.         REDIM table(n-1)
  144.         FOR i=0 TO n-1
  145.             table(i)=((PEEKB(rgb&)<<4) AND &hF00)+(PEEKB(rgb&+1) AND &H0F0)+ ((PEEKB(rgb&+2)>>4) AND &H0FFF)
  146.             rgb&=rgb&+3
  147.         NEXT i
  148.         LoadRGB4 screenptr&+screenViewPort,VARPTR(table(0)),n
  149.     END IF
  150.     getcmap=-1
  151. END FUNCTION
  152.  
  153.  
  154. DIM SHARED textrect%(rectangle_sizeof\2), stdrect%(rectangle_sizeof\2),tags&(40)
  155.  
  156. FUNCTION dclip&(BYVAL mode&,BYVAL  w, BYVAL h)
  157. STATIC i&
  158.     
  159.     dclip& = OSCAN_TEXT&
  160.  
  161.     IF QueryOverscan&(mode&,VARPTR(textrect(0)), OSCAN_TEXT&) THEN
  162.         IF QueryOverscan&(mode&, VARPTR(stdrect(0)), OSCAN_STANDARD&) THEN
  163.             IF    (w > textrect(RectangleMaxX\2) - textrect(RectangleMinX\2) + 1) OR _
  164.                 (h > textrect(RectangleMaxY\2) - textrect(RectangleMinY\2) + 1) THEN
  165.                     dclip& = OSCAN_STANDARD&
  166.             END IF
  167.         END IF
  168.     END IF
  169.     
  170. END FUNCTION
  171.  
  172.  
  173. FUNCTION  OpenIdScreen&(BYVAL mode&, BYVAL w, BYVAL h, BYVAL  depth%)
  174. STATIC penarray,ns(1)
  175.     IF PEEKW(LIBRARY("graphics.library")+lib_version)>= 36 THEN
  176.         IF ModeNotAvailable (mode&) THEN
  177.             mode&= mode& AND NOT(EXTENDED_MODE& OR SPRITES& OR GENLOCK_AUDIO& OR _
  178.                                GENLOCK_VIDEO& OR VP_HIDE&)
  179.             IF ModeNotAvailable (mode&) THEN
  180.                   IF((mode& AND  &hFFFF0000)<> 0) AND ((mode& AND &h00001000)=0) THEN
  181.                     ' bad CAMG present; use computed modes.
  182.                     mode& = 0
  183.                     IF w >= 640 THEN  mode& = HIRES&
  184.                       IF h >= 400 THEN  mode&= mode& OR LACE&
  185.                     IF depth=6 THEN
  186. ' This 6 planes == HAM or HALFBRITE is not
  187. ' necessarily true anymore, but hopefully all new  programs are writing a proper CAMG chunk!!
  188.                         PRINT "panic! EHB or HAM"
  189.                         OpenIdScreen&=0
  190.                         EXIT FUNCTION
  191.                     END IF
  192.                 END IF
  193.             END IF
  194.         END IF
  195.         penarray%=&hff00
  196.         PRINT "Using mode"; HEX$(mode&)
  197.         TAGLIST VARPTR(tags&(0)),SA_DisplayID&,    mode&, _
  198.                 SA_Width&,        w, _
  199.                 SA_Height&,        h, _
  200.                 SA_Depth&,        depth, _
  201.                 SA_Overscan&,    dclip&(mode&, w, h), _
  202.                 SA_SysFont&,        1, _
  203.                 SA_Pens&,        VARPTR(penarray), _
  204.                 SA_Behind&,        TRUE&, _
  205.                 SA_AutoScroll&,    TRUE&, _
  206.                 SA_Interleaved&,    TRUE&, _
  207.                 TAG_DONE&
  208.         OpenIdScreen&=OpenScreenTagList& (0, VARPTR(tags&(0)))
  209.     ELSE
  210.         REDIM ns(NewScreen_sizeof)
  211.         ns(NewScreenWidth\2)        = w
  212.         ns(NewScreenHeight\2)        = h
  213.         ns(NewScreenDepth\2)        = depth
  214.         ns(NewScreenViewModes\2)    = mode&
  215.         ns(NewScreenBlockPen\2)        = 1
  216.         ns(NewScreenType\2)            = CUSTOMSCREEN& OR SCREENBEHIND&
  217.  
  218.         OpenIdScreen&= OpenScreen&(VARPTR(ns(0)))
  219.     END IF
  220. END FUNCTION
  221.  
  222. '
  223. 'The main program
  224. '
  225. SUB main (filename$)
  226.     STATIC iff&, stream&, junk&, sp&, bmhd&, camg&, bm&, screenptr&, w, h, depth
  227.  
  228.     iff& = AllocIFF&
  229.     IF iff& THEN
  230.         stream& = xOpen&(SADD(filename$ + CHR$(0)), MODE_OLDFILE&)
  231.         IF stream& THEN
  232.             POKEL iff& + iff_Stream, stream&        'connect the DOS stream
  233.  
  234.             IF PEEKW(LIBRARY("dos.library") + lib_Version) >= 36 THEN
  235.             'for WB2 and above, use the buffered DOS I/O calls
  236.                 junk& = SetVBuf&(stream&, NULL&, BUF_FULL&, 8192)
  237.                 initIFFasBufferedDOS iff&
  238.             ELSE
  239.             'fall back for 1.3 (if you have 1.3 iffparse.library)
  240.                 InitIFFasDos iff&
  241.             END IF
  242.  
  243.             IF OpenIFF&(iff&, IFFF_READ&) = 0 THEN
  244.                 IF PropChunk&(iff&, ID_ILBM&, ID_BMHD&) = 0 AND _
  245.                   PropChunk&(iff&, ID_ILBM&, ID_CAMG&) = 0 AND _
  246.                   PropChunk&(iff&, ID_ILBM&, ID_CMAP&) = 0 AND _
  247.                   StopChunk&(iff&, ID_ILBM&, ID_BODY&) = 0 AND _
  248.                   ParseIFF(iff&, IFFPARSE_SCAN&) = 0
  249.  
  250.                     'look for a BMHD stored property
  251.                     sp& = FindProp&(iff&, ID_ILBM&, ID_BMHD&)
  252.                     bmhd& = 0
  253.                     IF sp& <>0 THEN
  254.                         bmhd& = PEEKL(sp& + sp_Data)
  255.                         PRINT "BMHD info:"
  256.                         w= PEEKW(bmhd& + bmh_Width)
  257.                         PRINT "bmh_Width = "; w
  258.                         h= PEEKW(bmhd& + bmh_Height)
  259.                         PRINT "bmh_Height = "; h
  260.                         PRINT "bmh_Left = "; PEEKW(bmhd& + bmh_Left)
  261.                         PRINT "bmh_Top = "; PEEKW(bmhd& + bmh_Top)
  262.                         depth= PEEKB(bmhd& + bmh_Depth)
  263.                         PRINT "bmh_Depth = "; depth
  264.                         PRINT "bmh_Masking = "; PEEKB(bmhd& + bmh_Masking)
  265.                         PRINT "bmh_Compression = "; PEEKB(bmhd& + bmh_Compression)
  266.                         PRINT "bmh_Pad = "; PEEKB(bmhd& + bmh_Pad)
  267.                         PRINT "bmh_Transparent = "; PEEKW(bmhd& + bmh_Transparent)
  268.                         PRINT "bmh_XAspect = "; PEEKB(bmhd& + bmh_XAspect)
  269.                         PRINT "bmh_YAspect = "; PEEKB(bmhd& + bmh_YAspect)
  270.                         PRINT "bmh_PageWidth = "; PEEKW(bmhd& + bmh_PageWidth)
  271.                         PRINT "bmh_PageHeight = "; PEEKW(bmhd& + bmh_PageHeight)
  272.                     END IF
  273.  
  274.                     'look for a CAMG stored property
  275.                     sp& = FindProp&(iff&, ID_ILBM&, ID_CAMG&)
  276.                     IF sp& <>0 THEN
  277.                         camg& = PEEKL(PEEKL(sp& + sp_Data))
  278.                         PRINT "CAMG = "; HEX$(camg&)
  279.                     END IF
  280.                     IF bmhd& THEN
  281.                         bm& = SafeAllocBitMap&(w,h,depth, BMF_CLEAR& OR BMF_DISPLAYABLE&, NULL&)
  282.                         ReadBody iff&, bm&,bmhd&
  283.                         screenptr&=OpenIdScreen&(camg&,w, h, depth)
  284.                         IF screenptr& THEN
  285.                             IF GetCMAP(iff&,screenptr&)=0 THEN PRINT "No color map"
  286.                             ScreenToFront& screenptr&
  287.                             junk&=BltBitMapRastPort(bm&, 0, 0,screenptr&+RastPort, 0, 0, w, h, &h0c0)
  288.                             DO
  289.                             LOOP UNTIL LEN(INKEY$)
  290.                             junk&=CloseScreen&(screenptr&)
  291.                         ELSE
  292.                             PRINT "Can't open screen"
  293.                         END IF
  294.                         SafeFreeBitMap bm&
  295.                     
  296.                     END IF
  297.                 END IF
  298.                 CloseIFF iff&
  299.                 junk& = xClose(PEEKL(iff& + iff_Stream))
  300.                 FreeIFF iff&
  301.             END IF
  302.         ELSE
  303.             PRINT filename$;" not found"
  304.         END IF
  305.     END IF
  306. END SUB
  307.  
  308. '
  309. ' Start the main program
  310. '
  311. LIBRARY OPEN "dos.library"
  312. LIBRARY OPEN "graphics.library"
  313. LIBRARY OPEN "iffparse.library"
  314. LIBRARY OPEN "exec.library"
  315. LIBRARY OPEN "intuition.library"
  316. main LTRIM$(RTRIM$(COMMAND$))
  317.